home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / strlink.com / STROBJ.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1981-09-01  |  3.5 KB  |  126 lines
  1. {$D-,R-,S+}
  2.  
  3. UNIT StrObj;
  4.  
  5.    {Linked list holds strings.
  6.  
  7. Version 1.00: released to the public domain on 28 August 1989.
  8.  
  9. Version 1.01: released to the public domain on 1 September 1989.
  10.    The TPRO5 conditional compilation directive has been removed.  The code is
  11. just as fast with TPRO5 as it is without it.
  12.    Added a call to the standard procedure FAIL inside the Init() constructor
  13. in case there isn't enough memory to add a new string to the heap.
  14.    Added new method that returns length of the string.  Much faster than just
  15. checking the length with LENGTH(GetString).}
  16.  
  17.  
  18. INTERFACE {section}
  19.  
  20. USES
  21.    Objects;
  22.  
  23.  
  24. TYPE
  25.    StrObjectPtr = ^StrObject;
  26.    StrObject
  27.     = OBJECT(Node)
  28.       TheStrPtr : POINTER;
  29.  
  30.       CONSTRUCTOR Init(NewStr : STRING);
  31.       DESTRUCTOR  Done; VIRTUAL;
  32.  
  33.       FUNCTION  GetString : STRING;
  34.       FUNCTION  GetStringLength : BYTE;
  35.       PROCEDURE ChangeString(NewStr : STRING);
  36.       FUNCTION  SelfPtr : StrObjectPtr;
  37.       END;
  38.  
  39.  
  40. IMPLEMENTATION {section}
  41.  
  42.  
  43. {============================================================================}
  44. CONSTRUCTOR StrObject.Init(NewStr : STRING);
  45.  
  46.    {Initialize the StrObject.  ...I originally used SUCC(LENGTH(NewStr)) to
  47. determine the size of the true string array, but I forgot that SUCC returns
  48. a value of the same type as the variable you sent it.  That's bad news if you
  49. try to put a 255-char string on the heap!  Think about it.}
  50.  
  51. VAR
  52.    TrueStrSize : WORD;
  53.  
  54. BEGIN {StrObject.Init}
  55. TrueStrSize := (LENGTH(NewStr) + 1); {must account for 0th byte!}
  56.  
  57. IF (MAXAVAIL < TrueStrSize)
  58.  THEN
  59.     FAIL
  60.  ELSE
  61.     BEGIN
  62.     GETMEM({VAR} TheStrPtr,TrueStrSize);
  63.     MOVE(NewStr,TheStrPtr^,TrueStrSize)
  64.     END
  65. END; {StrObject.Init}
  66. {============================================================================}
  67.  
  68. {============================================================================}
  69. DESTRUCTOR  StrObject.Done;
  70.  
  71.    {De-initialize the StrObject.  See my comments in the Init routine!}
  72.  
  73. VAR
  74.    TrueStrSize : WORD;
  75.  
  76. BEGIN {StrObject.Done}
  77. TrueStrSize := (BYTE(TheStrPtr^) + 1);
  78. FREEMEM(TheStrPtr,TrueStrSize)
  79. END; {StrObject.Done}
  80. {============================================================================}
  81.  
  82. {============================================================================}
  83. FUNCTION  StrObject.GetString : STRING;
  84.  
  85.    {Return the Str from the object.}
  86.  
  87. BEGIN {GetString}
  88. GetString := STRING(TheStrPtr^)
  89. END; {GetString}
  90. {============================================================================}
  91.  
  92. {============================================================================}
  93. FUNCTION  StrObject.GetStringLength : BYTE;
  94.  
  95.    {Return the length of the Str from the object.  Much faster than calling
  96. LENGTH(GetString).}
  97.  
  98. BEGIN {GetString}
  99. GetStringLength := BYTE(TheStrPtr^)
  100. END; {GetString}
  101. {============================================================================}
  102.  
  103. {============================================================================}
  104. PROCEDURE StrObject.ChangeString(NewStr : STRING);
  105.  
  106.    {Changes the Str in the object to the NewStr.}
  107.  
  108. BEGIN {ChangeString}
  109. Done;
  110. Init(NewStr)
  111. END; {ChangeString}
  112. {============================================================================}
  113.  
  114. {============================================================================}
  115. FUNCTION    StrObject.SelfPtr : StrObjectPtr;
  116.  
  117.    {Returns a pointer to this object.}
  118.  
  119. BEGIN {SelfPtr}
  120. SelfPtr := @Self
  121. END; {SelfPtr}
  122. {============================================================================}
  123.  
  124.  
  125. END. {StrObj}
  126.